perm filename CHAT.MID[S,NET]1 blob
sn#642408 filedate 1982-02-08 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00007 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE CHAT
C00004 00003 INBUFH OUTBFH TTYBFH GOTINT NSVBLK NSVMSG NSVRPL RFCBLK HOST SMRBLK RMRBLK INPBLK CRLF BEEPC
C00006 00004 CHAT GETHST GOTHST NSVTRY
C00009 00005 CHAT1 CHAT2
C00011 00006 LOOP TTILUP
C00013 00007 TTIDUN TTIDN1 TTIDN2 NTICHR FLUSH CLOSED
C00016 ENDMK
C⊗;
TITLE CHAT
SUBTTL Definitions
; Mark Crispin, SU-AI, November '81
; Prototype Ethernet user TELNET. Somebody ought to write the real thing
; AC definitions
A=1
B=2
; System bit definitions
INTTTY==020000,, ; TTY input
INTCLK==000200,, ; clock interrupts
INTIMS==000020,, ; closed interrupt
INTINP==000010,, ; input interrupt
IODTER==100000 ; Time out
IOBKTL==040000 ; Mark seen
IODEND==020000 ; End seen
BSACT== 000020 ; activate on BS
SPCBRK==000100,, ; special activation mode
DISLIN==400000,, ; III
DMLIN== 040000,, ; DM
DDDLIN==020000,, ; DD
INTBTS==INTTTY\INTCLK\INTINP\INTIMS
; Macro to build an Ethernet host address
DEFINE HST NET,ADR
<NET←8.>+ADR TERMIN
;INBUFH OUTBFH TTYBFH GOTINT NSVBLK NSVMSG NSVRPL RFCBLK HOST SMRBLK RMRBLK INPBLK CRLF BEEPC
SUBTTL Data area
INBUFH: BLOCK 3 ; input buffer
OUTBFH: BLOCK 3 ; output buffer
TTYBFH: BLOCK 3 ; TTY buffer header
GOTINT: BLOCK 1 ; -1 → got an interrupt
NSVMSG: BLOCK 140. ; name server message
NSVRPL: BLOCK 140. ; name server reply
RFCBLK: 0 ; connect to remote host
0 ; status word
RFCLSK: 0 ; socket number (1 for TELNET)
-1 ; wait flag
8 ; byte size
RFCFSK: 1 ; foreign socket number
HOST: 0 ; host
;For name request
MSCBLK: 1 ;Opcode = LISTEN (we will broadcast)
MSCSTS: 0 ;Status
-1 ;Local socket (GENSYM)
0 ;Wait for connection
8 ;Bytesize (checked, but not used by PUP)
4 ;Foreign socket
-1 ;Host number
SMRBLK: 25 ; send Mark
0 ; status word
6 ; Timing Mark Reply
RMRBLK: 26 ; read last Mark
0 ; status word
0 ; Mark type returned here
INPBLK: 10 ; skip if input available
0 ; status word
CRLF: ASCIZ/
/
BEEPC: -1 ; assume beeping for default
;CHAT GETHST GOTHST NSVTRY
SUBTTL Start of program
CHAT: CAI
RESET ; flush all I/O
INIT 15 ; get a datagram channel on PUP:
SIXBIT/PUP/
0
JRST [ OUTSTR [ASCIZ/Device PUP not available/]
EXIT]
; All this is pretty crude, but it works...
MTAPE MSCBLK
MOVE MSCBLK+1 ; check for MTAPE error
STATO 467600
TRNE 77
JRST [ OUTSTR [ASCIZ/Pup links busy/]
EXIT]
OUTSTR [ASCIZ/Host = /]
DMOVE A,[441000,,NSVMSG+5 ; data area
22.] ; overhead bytes
GETHST: INCHWL ; get a character
ANDI 177 ; debuckyify
CAIN ↑M ; ignore CR
JRST GETHST
CAIE 175 ; ALT?
CAIN ↑J
JRST GOTHST
IDPB A ; save character
AOJA B,GETHST ; count it and continue
GOTHST: DPB B,[242000,,NSVMSG] ; set data size
MOVEI 220 ; Name lookup request
DPB [041000,,NSVMSG]
OUTSTR [ASCIZ/ Trying... /]
MOVEI A,15. ; try up to 15 times before giving up
NSVTRY: OUT [-140,,NSVMSG-1?0] ; send name server message
CAIA
JRST [OUTSTR [ASCIZ/Can't send to name server/]
EXIT]
MTAPE INPBLK ; is there any input present?
JRST [ MOVEI 1 ; wait a second and try again
SLEEP
MTAPE INPBLK ; got it this time?
CAIA
JRST .+1
SOJG A,NSVTRY ; no, try again
OUTSTR [ASCIZ/Timed out waiting for name server reply/]
EXIT]
IN [-140,,NSVRPL-1?0] ; get name server reply
CAIA
JRST 4,CHAT ; can't happen
CLOSE ; close connection to name server
RELEASE
LDB [041000,,NSVRPL] ; get type
CAIE 221 ; Name server reply?
JRST [ OUTSTR [ASCIZ/Host name not found/]
EXIT]
LDB [242000,,NSVRPL+5]
MOVEM HOST
; JRST CHAT1
;CHAT1 CHAT2
CHAT1: HRROI [003000,,]
TTYSET ; get line characteristics
CAMN [-1]
EXIT ; how can I work if detached?
TLNE (DISLIN\DMLIN\DDDLIN) ; display?
JRST CHAT2
HRROI [001000,,(SPCBRK)]
TTYSET
CHAT2: SETACT [[ 777777,,777777; activate on everything
777777,,777777; just set it up for when we need it
777777,,777777
777777,,600000\BSACT]]
INIT
SIXBIT/PUP/
OUTBFH,,INBUFH
JRST [ OUTSTR [ASCIZ/Device PUP not available. Try again later./]
EXIT]
INIT 1,
SIXBIT/TTY/
TTYBFH,,
JRST 4,CHAT
MOVEI 8. ; change byte size in buffer header
DPB [300600,,INBUFH+1]
DPB [300600,,OUTBFH+1]
INBUF
OUTBUF
OUTBUF 1,
SETOM RFCLSK ; make sure we get a wild socket number
MOVEI 1
MOVEM RFCFSK
MTAPE RFCBLK
MOVE RFCBLK+1 ; check for MTAPE error
STATO 467600
TRNE 77
JRST [ OUTSTR [ASCIZ/Host dead/]
EXIT]
OUTSTR [ASCIZ/Open
/]
PTJOBX [0 ? 3]
LOCK
SETZM GOTINT
MOVEI [ SETOM GOTINT ; got an interrupt
DISMIS] ; set up interrupt server
MOVEM JOBAPR
CLKINT 30.*60. ; keep alive counter
MOVSI (INTBTS)
INTENB ; enable interrupts
; JRST LOOP
;LOOP TTILUP
LOOP: INTMSK [0] ; mask off interrupts
SKIPN GOTINT ; got an interrupt?
IMSTW [INTBTS] ; wait for an interrupt to happen
SETZM GOTINT
TTILUP: INCHSL ; get a byte from the TTY
JRST TTIDUN ; nothing, try input from the network
CAIN ↑M ; if a CR,
INCHRW A ; flush the LF right after it
CAIN 175 ; ALT
MOVEI 33
CAIN 176 ; }
MOVEI 175
CAIN 32 ; ~
MOVEI 176
CAIE 600\"L ; CONTROL-META-L is character mode
CAIN 600\"l
JRST [HRROI [001000,,(SPCBRK)]
TTYSET
JRST TTILUP]
CAIE 400\"L ; META-L is line mode
CAIN 400\"l
JRST [HRROI [002000,,(SPCBRK)]
TTYSET
JRST TTILUP]
CAIE 600\"Q ; CONTROL-META-Q exits
CAIN 600\"q
JRST FLUSH
CAIE 400\"Q ; so does META-Q
CAIN 400\"q
JRST FLUSH
CAIE 600\"G ; CONTROL-META-G
CAIN 600\"g
JRST [SETZM BEEPC ; disable beeping
JRST TTILUP]
CAIE 400\"G ; META-G
CAIN 400\"g
JRST [SETOM BEEPC ; enable beeping
JRST TTILUP]
ANDI 377 ; turn off META bit
TRZE 200 ; CONTROL set?
ANDI 37
SOSG OUTBFH+2 ; space in buffer?
OUT
CAIA
JRST TTIDUN
IDPB OUTBFH+1
JRST TTILUP
;TTIDUN TTIDN1 TTIDN2 NTICHR FLUSH CLOSED
TTIDUN: MOVE A,OUTBFH+2
ANDI A,3
MOVE A,[0
1
3
7](A)
SKIPLE OUTBFH ; set fill bits only if buffers are setup properly
DPB A,[ 000420,,OUTBFH+1]
; POINT 4,@OUTBFH+1,35 ; Sigh... This can't be in a literal???
OUTPUT ; flush the output side of things
TTIDN1: SOSLE INBUFH+2 ; data available?
JRST NTICHR
HRRZ A,INBUFH
HRRZ A,(A)
SKIPGE (A) ; anything in further buffers?
JRST TTIDN2
MTAPE INPBLK ; no - new packet available?
JRST [ OUTPUT 1,
STATZ IODEND
JRST CLOSED
JRST LOOP]
TTIDN2: IN ; yes - get it
JRST TTIDN3
GETSTS A
TRZE A,IODEND\IODTER ; End seen?
JRST CLOSED
TRZN A,IOBKTL ; Mark seen?
JRST 4,.-1
SETSTS (A) ; yes, clear error status
MTAPE RMRBLK
TRN
MOVE RMRBLK+2 ; get Mark type
;; CAIN 1 ; Data Mark?
;; AOS NTOINP
CAIE 5 ; Timing Mark?
JRST TTIDN1 ; something random
MTAPE SMRBLK ; yes, send Timing Mark Reply
JRST CLOSED
JRST TTIDN1
TTIDN3: MOVE A,INBUFH ; get buffer header
ADD A,1(A) ; find last word in buffer
MOVE A,1(A) ; get that word
ANDI A,7 ; look at low order bits (faster than LDB)
TRNE A,4
SKIPA A,[4] ; 7 means 4-1 unused bytes
TRNE A,2 ; 3 means 3-1 unused bytes
SUBI A,1
MOVN A,A
ADDM A,INBUFH+2 ; update count to account for fill bytes
NTICHR: ILDB INBUFH+1
SETO A,
SKIPE BEEPC ; skip if not beeping π today
CAIE ↑G ; skip if need to beep
CAIA
BEEP A,
CAIN 176 ; ~
MOVEI 32
CAIN 175 ; }
MOVEI 176
CAIN 33 ; ALT
MOVEI 175
SOSG TTYBFH+2 ; output character to TTY
OUTPUT 1,
IDPB TTYBFH+1
JRST TTIDN1
FLUSH: RELEASE ; flush connection
CLOSED: OUTPUT 1, ; flush TTY buffer
OUTSTR [ASCIZ/
Connection closed
/]
EXIT
END CHAT